home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / utils / ted / tedtro7.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-10-02  |  6.3 KB  |  230 lines
  1. {
  2.                           Coding & Editing by :
  3.         █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀█ █ █▀▀▀▀▀▀▀ █▀▀▀▀▀▀▀
  4.         █▀▀▀▀▀▀▀ █▀▀▀▀▀▀█ █▀▀▀▀▀█▀ █▀▀▀▀▀▀█ █     █ █ ▀▀▀▀▀▀▀█ █▀▀▀▀▀
  5.         █        █      █ █      █ █      █ █     █ █        █ █
  6.         █        █      █ █      █ █      █ █     █ █        █ █
  7.         █        █      █ █      █ █      █ █     █ █        █ █
  8.         █        █      █ █      █ █      █ █▄▄▄▄▄█ █ ▄▄▄▄▄▄▄█ █▄▄▄▄▄▄▄
  9.  
  10.         Programmed by Marcin Jaskowiak, aka Paradise, Lublin, Poland,
  11.                           in Turbo Pascal 7.0.
  12.  
  13.         This is FUQNWARE - if u like it, u must register it by sending
  14.         some money (u tell how much) to ME:) if not - u choose.
  15.         Read TED.DOC 4 more info.
  16.  
  17.         Snail mail:                      Email:
  18.         Marcin Jaskowiak                 liksay@bachus.umcs.lublin.pl
  19.         Flat 114, 3 Zarnowiecka Str.
  20.         20-630 Lublin
  21.         Poland
  22.  
  23.                                Presents :
  24.                     TED font editor SCROLLERS PACK 94
  25.                                 with :
  26.                              EXAMPLE NR 7
  27. }
  28. PROGRAM TED_INTRO_NR7;
  29. USES DOS,CRT;
  30.  
  31. CONST
  32.  SEGA000        : WORD = $A000;
  33.  SIZEY          = 60;
  34. VAR
  35.  BITMAP         : ARRAY [0..59*320-1] OF BYTE;
  36.  PALETTE        : ARRAY [0..255,1..3] OF BYTE;
  37.  CHARS          : ARRAY [' '..']'] OF POINTER;
  38.  CHARSDATA      : ARRAY [' '..']',1..3] OF BYTE;
  39.  F              : FILE;
  40.  B,ROW,NR,IDX   : BYTE;
  41.  X,Y,I,J        : INTEGER;
  42.  CH,K           : CHAR;
  43.  TEKST          : STRING;
  44.  S1,S2          : ARRAY [0..255] OF BYTE;
  45.  CPOS           : ARRAY [0..319] OF WORD;
  46.  FSEG,FOFS      : WORD;
  47.  
  48. {───────────────────────────────────────────────────────────────────────────}
  49. PROCEDURE CALCCPOS;
  50. VAR I: INTEGER;
  51. BEGIN
  52.  FOR I:=0 TO 319 DO
  53.   CPOS[I]:=320*(S1[(I+IDX) MOD 230]+S2[I MOD 115])+I;
  54. END;
  55. {───────────────────────────────────────────────────────────────────────────}
  56. PROCEDURE CALCSIN;
  57. VAR I: INTEGER;
  58. BEGIN
  59.  FOR I:=0 TO 230 DO S1[I]:=ROUND(SIN(2*I*PI/230)*20)+20;
  60.  FOR I:=0 TO 115 DO S2[I]:=ROUND(SIN(2*I*PI/115)*3)+3;
  61. END;
  62. {───────────────────────────────────────────────────────────────────────────}
  63. PROCEDURE INITVGA; ASSEMBLER; { INITIALIZE VGA CARD MODE 13H }
  64. ASM
  65.  MOV AX,0013H
  66.  INT 10H
  67. END;
  68. {───────────────────────────────────────────────────────────────────────────}
  69. PROCEDURE CLOSEVGA; ASSEMBLER; { CLOSE VGA MODE AND SET TEXT }
  70. ASM
  71.  MOV AX,0003H
  72.  INT 10H
  73. END;
  74. {───────────────────────────────────────────────────────────────────────────}
  75. PROCEDURE VSYNC; ASSEMBLER;
  76. ASM
  77.  MOV DX,03DAH
  78.  @@1: IN AL,DX; TEST AL,8; JNZ @@1;
  79.  @@2: IN AL,DX; TEST AL,8; JZ  @@2;
  80. END;
  81. {───────────────────────────────────────────────────────────────────────────}
  82. PROCEDURE DRAWBITMAP; ASSEMBLER;
  83. ASM
  84.  MOV ES,SEGA000
  85.  XOR CX,CX
  86. @@0:
  87.  XOR DX,DX
  88.  MOV SI,CX
  89.  ADD SI,CX
  90.  MOV DI,WORD PTR CPOS[SI]
  91.  MOV SI,CX
  92. @@1:
  93.  MOV AL,BYTE PTR BITMAP[SI]
  94.  MOV [ES:DI],AL
  95.  ADD SI,320
  96.  ADD DI,320
  97.  INC DL
  98.  CMP DL,SIZEY
  99.  JNE @@1
  100.  INC CX
  101.  CMP CX,319
  102.  JNE @@0
  103. END;
  104. {───────────────────────────────────────────────────────────────────────────}
  105. PROCEDURE SCROLLBITMAP(VAR MAP); ASSEMBLER;
  106. ASM
  107.   LDS SI,MAP
  108.   LES DI,MAP
  109.   INC SI
  110.   INC SI
  111.   MOV CX,9600
  112.   REP MOVSW
  113. END;
  114. {───────────────────────────────────────────────────────────────────────────}
  115. PROCEDURE SETCOLOR(NR,R,G,B: BYTE); ASSEMBLER; { SET RGB VAL TO COLOR NR }
  116. ASM
  117.  MOV DX,3C8H
  118.  MOV AL,NR
  119.  OUT DX,AL
  120.  INC DX
  121.  MOV AL,R
  122.  OUT DX,AL
  123.  MOV AL,G
  124.  OUT DX,AL
  125.  MOV AL,B
  126.  OUT DX,AL
  127. END;
  128. {───────────────────────────────────────────────────────────────────────────}
  129. PROCEDURE LOADPAL(NAME: STRING); { LOAD .PAL FILE AND SET PALETTE }
  130. BEGIN
  131.  ASSIGN(F,NAME+'.PAL');
  132.  RESET(F,1);
  133.  BLOCKREAD(F,PALETTE,768);
  134.  CLOSE(F);
  135.  FOR B:=0 TO 255 DO SETCOLOR(B,PALETTE[B,1],PALETTE[B,2],PALETTE[B,3]);
  136. END;
  137. {───────────────────────────────────────────────────────────────────────────}
  138. PROCEDURE LOADTED(NAME: STRING); { LOAD .TED FILE TO MEMORY }
  139. VAR TX,TY: BYTE; CH: CHAR;
  140. BEGIN
  141.  ASSIGN(F,NAME+'.TED');
  142.  RESET(F,1);
  143.  SEEK(F,20);
  144.  WHILE NOT(EOF(F)) DO
  145.  BEGIN
  146.   BLOCKREAD(F,CH,1);
  147.   BLOCKREAD(F,TX,1);
  148.   BLOCKREAD(F,TY,1);
  149.   GETMEM(CHARS[CH],TX*TY);
  150.   CHARSDATA[CH,1]:=TX; CHARSDATA[CH,2]:=TY; CHARSDATA[CH,3]:=1;
  151.   BLOCKREAD(F,CHARS[CH]^,TX*TY);
  152.  END;
  153.  CLOSE(F);
  154.  IF CHARSDATA[' ',3]<>1 THEN { IF NOT SPACE " " THEN CREATE IT }
  155.  BEGIN
  156.   TX:=CHARSDATA['A',1];
  157.   TY:=CHARSDATA['A',2];
  158.   GETMEM(CHARS[' '],TX*TY);
  159.   FILLCHAR(CHARS[' ']^,TX*TY,0);
  160.   CHARSDATA[' ',3]:=1;
  161.   CHARSDATA[' ',1]:=TX;
  162.   CHARSDATA[' ',2]:=TY;
  163.  END;
  164. END;
  165. {───────────────────────────────────────────────────────────────────────────}
  166. PROCEDURE DONETED; { DEALLOCATE FONT MEMORY }
  167. VAR CH: CHAR;
  168. BEGIN
  169.  FOR CH:=' ' TO ']' DO
  170.  BEGIN
  171.   IF CHARSDATA[CH,3]=1 THEN
  172.   BEGIN
  173.    FREEMEM(CHARS[CH],CHARSDATA[CH,1]*CHARSDATA[CH,2]);
  174.    CHARSDATA[CH,3]:=0;
  175.   END;
  176.  END;
  177. END;
  178. {───────────────────────────────────────────────────────────────────────────}
  179. PROCEDURE NEWROW(CH: CHAR; RO: BYTE; POS: INTEGER); { DRAW HORIZ LINE }
  180. VAR TX,TY,IC: INTEGER;
  181. BEGIN
  182.  IF CHARSDATA[CH,3]<>1 THEN EXIT; { EXIT IF NO CHAR IN FONT }
  183.  IC:=(60-CHARSDATA[CH,2]) DIV 2; { START OF PIC IN "BITMAP" }
  184.  FOR TY:=0 TO 59 DO BITMAP[TY*320+POS]:=0;
  185.  IF RO=CHARSDATA[CH,1]+1 THEN
  186.   FOR TY:=1 TO CHARSDATA[CH,2] DO BITMAP[(TY+IC)*320+POS]:=0 { SKIP ONE ROW }
  187.  ELSE
  188.   FOR TY:=1 TO CHARSDATA[CH,2] DO
  189.    BITMAP[(TY+IC)*320+POS]:=MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(TY-1)*CHARSDATA[CH,1]+RO-1];
  190. END;
  191. {───────────────────────────────────────────────────────────────────────────}
  192. PROCEDURE UPDATE; { NEW VALUES ? }
  193. BEGIN
  194.  INC(ROW);
  195.  IF ROW>CHARSDATA[TEKST[NR],1]+1 THEN
  196.  BEGIN
  197.   ROW:=1;
  198.   INC(NR);
  199.   IF NR>LENGTH(TEKST) THEN NR:=1;
  200.  END;
  201. END;
  202. {───────────────────────────────────────────────────────────────────────────}
  203.  
  204.  
  205.  
  206. BEGIN
  207.  CALCSIN;
  208.  INITVGA;
  209.  LOADPAL('FONT010');
  210.  LOADTED('FONT010');
  211.  ROW:=1;
  212.  TEKST:='NOW MAYBE SOME REALLY SINUS SCROLLING!!!!  DO EYE LIKE IT?   '+
  213.         '&&& FONT IS COOL TOO... ###  :-]           THATS ALL DUDE!              ';
  214.  NR:=1;
  215.  FILLCHAR(BITMAP,SIZEOF(BITMAP),0);
  216.  IDX:=0;
  217.  REPEAT
  218.   SCROLLBITMAP(BITMAP);
  219.   UPDATE;
  220.   NEWROW(TEKST[NR],ROW,318);
  221.   UPDATE;
  222.   NEWROW(TEKST[NR],ROW,319);
  223.   VSYNC;
  224.   CALCCPOS;
  225.   DRAWBITMAP;
  226.   IDX:=4+(IDX MOD 230);
  227.  UNTIL KEYPRESSED;
  228.  DONETED;
  229.  CLOSEVGA;
  230. END.